library(plotly)
Warning: package ‘plotly’ was built under R version 4.1.3Registered S3 method overwritten by 'data.table':
method from
print.data.table
Registered S3 methods overwritten by 'htmltools':
method from
print.html tools:rstudio
print.shiny.tag tools:rstudio
print.shiny.tag.list tools:rstudio
Registered S3 method overwritten by 'htmlwidgets':
method from
print.htmlwidget tools:rstudio
Attaching package: ‘plotly’
The following object is masked from ‘package:ggplot2’:
last_plot
The following object is masked from ‘package:stats’:
filter
The following object is masked from ‘package:graphics’:
layout
hb_agesex <- read.csv("raw_data/covid_raw_data/hospital_admissions_hb_agesex_20220302.csv") %>% clean_names()
hb_names <- read_csv("raw_data/covid_raw_data/health_board_names.csv") %>% clean_names()
hb_agesex %>% names()
hb_agesex %>% head()
hb_agesex %>% distinct(hb)
The health board number is not very useful or easy to make connections with, we should change this to the name of the health board
#select only the columns with health board names
hb_names <- hb_names %>%
select(hb, hb_name)
#join to get health board names
hb_agesex <- hb_agesex %>%
left_join(hb_names, by = "hb")
#Fill in NAs in hb_name - these are NA because the code is the country code for NHS Scotland
hb_agesex <- hb_agesex %>%
mutate(hb_name = if_else(
is.na(hb_name),
"All Scotland",
hb_name
))
hb_agesex %>%
distinct(admission_type)
We have three different admission types (all, emergency, planned) - should we only be looking at emergency admission types (e.g. acute)?
hb_agesex %>%
distinct(hb)
hb_agesex %>%
distinct(week_ending)
#change week_ending into date format
hb_agesex <- hb_agesex %>%
mutate(week_ending = ymd(week_ending))
hb_agesex <- hb_agesex %>%
mutate(month = month(week_ending, label = TRUE),
year = year(week_ending), .after = week_ending)
#create winter and non winter groups
hb_agesex <- hb_agesex %>%
mutate(is_winter = if_else(
month %in% c("Dec", "Jan", "Feb"), TRUE, FALSE
), .after = month)
#compare mean admissions in 2020/2021/2022 with 2018/2019 averages
hb_agesex %>%
filter(admission_type == "Emergency",
age_group == "All ages",
sex == "All") %>%
group_by(hb_name, week_ending) %>%
summarise(mean_admissions = mean(number_admissions),
mean_20182019_admissions = mean(average20182019)) %>%
ggplot() +
geom_line(aes(x = week_ending,
y = mean_admissions), group = 1, colour = "red") +
geom_line(aes(x = week_ending,
y = mean_20182019_admissions), group = 1, colour = "blue") +
scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4)+
geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4)+
geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4)+
facet_wrap(~hb_name, scales = "free_y") +
labs(x = "Date",
y = "Average admissions per week",
colour = "Covid vs Pre-Covid")
No significant differences
#get boxplots to compare spread of number of admissions for winter vs not winter
hb_agesex %>%
filter(admission_type == "Emergency",
age_group == "All ages",
sex == "All",
hb_name == "All Scotland") %>%
ggplot(aes(x = number_admissions,
y = is_winter)) +
geom_boxplot() +
geom_jitter(colour = "grey30", alpha = 0.5)
Not expecting significant difference
H0 - number of admissions(winter) = number of admissions(not winter) H1 - number of admissions(winter) > number of admissions(not winter)
null_distribution <- hb_agesex %>%
filter(admission_type == "Emergency",
age_group == "All ages",
sex == "All",
hb_name == "All Scotland") %>%
specify(number_admissions ~ is_winter) %>%
hypothesise(null = "independence") %>%
generate(reps = 5000, type = "permute") %>%
calculate(stat = "diff in means", order = c("TRUE", "FALSE"))
observed_stat <- hb_agesex %>%
filter(admission_type == "Emergency",
age_group == "All ages",
sex == "All",
hb_name == "All Scotland") %>%
specify(number_admissions ~ is_winter) %>%
calculate(stat = "diff in means", order = c("TRUE", "FALSE"))
null_distribution %>%
visualise() +
shade_p_value(obs_stat = observed_stat, direction = "right")
p_value <- null_distribution %>%
get_p_value(obs_stat = observed_stat, direction = "right")
p_value
No significant differences
hb_agesex %>%
filter(admission_type == "Emergency",
age_group == "All ages",
sex == "All",
hb_name != "All Scotland") %>%
group_by(hb_name, is_winter) %>%
summarise(mean_num_admissions = mean(number_admissions)) %>%
ggplot(aes(x = hb_name,
y = mean_num_admissions,
fill = is_winter)) +
geom_col(position = "dodge") +
scale_y_sqrt()
`summarise()` has grouped output by 'hb_name'. You can override using the `.groups` argument.
NA
#compare percent variation for winter not winter
hb_agesex %>%
filter(admission_type == "Emergency",
age_group == "All ages",
sex == "All",
hb_name == "All Scotland") %>%
ggplot(aes(x = percent_variation,
y = is_winter)) +
geom_boxplot() +
geom_jitter(colour = "grey30", alpha = 0.5)
No significant differences
#get box plot for number of admissions by sex and whether or not it is winter
hb_agesex %>%
filter(sex != "All",
admission_type == "Emergency",
hb_name == "All Scotland") %>%
ggplot(aes(x = number_admissions,
y = sex,
colour = is_winter)) +
geom_boxplot() +
geom_jitter(colour = "grey30", alpha = 0.5)
#get bar graphs for mean number of admissions for each month by sex
hb_agesex %>%
filter(admission_type == "Emergency",
sex != "All",
hb_name == "All Scotland") %>%
group_by(hb_name, month, sex) %>%
summarise(mean_admissions = mean(number_admissions)) %>%
ggplot() +
geom_col(aes(x = month,
y = mean_admissions,
fill = sex), position = "dodge")
`summarise()` has grouped output by 'hb_name', 'month'. You can override using the `.groups` argument.
hb_agesex %>%
filter(admission_type == "Emergency",
sex != "All",
hb_name == "All Scotland") %>%
group_by(hb_name, month, sex) %>%
summarise(mean_20182019_admissions = mean(average20182019)) %>%
ggplot() +
geom_col(aes(x = month,
y = mean_20182019_admissions,
fill = sex), position = "dodge")
`summarise()` has grouped output by 'hb_name', 'month'. You can override using the `.groups` argument.
For age groups over 65, admissions are slightly higher in the winter. The same pattern is not seen for younger age groups The increase in admissions in winter months for age groups over 65 was more drastic pre-Covid than during Covid. This is potentially due to the lockdown measures in winter Dec2020/Jan-Feb2021 and some remaining restrictions in winter Dec2021/Jan-Feb 2022 as well as the vaccination campaign targeting these age groups in early 2021 with boosters in late 2021/early 2022.
#get line graph of average number of admissions over time for each age group
hb_agesex %>%
filter(admission_type == "Emergency",
age_group != "All ages",
hb_name == "All Scotland") %>%
group_by(hb_name, week_ending, age_group) %>%
summarise(mean_admissions = mean(number_admissions)) %>%
ggplot() +
geom_line(aes(x = week_ending,
y = mean_admissions,
colour = ordered(age_group, levels = c("Under 5",
"5 - 14",
"15 - 44",
"45 - 64",
"65 - 74",
"75 - 84",
"85 and over")))) +
scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4)+
geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4)+
geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4)+
labs(x = "Month",
y = "Average number of admissions per week",
colour = "Age group")
#get line graph comparing pre-Covid admissions to Covid admissions for each age group
hb_agesex %>%
filter(admission_type == "Emergency",
age_group != "All ages",
hb_name == "All Scotland") %>%
group_by(hb_name, month, age_group) %>%
summarise(mean_admissions = mean(number_admissions),
mean_20182019_admissions = mean(average20182019)) %>%
ggplot() +
geom_line(aes(x = month,
y = mean_admissions), group = 1, colour = "red") +
geom_line(aes(x = month,
y = mean_20182019_admissions), group = 1, colour = "blue") +
facet_wrap(~age_group)
hb_agesex %>%
filter(admission_type == "Emergency",
age_group != "All ages",
hb_name == "All Scotland") %>%
group_by(hb_name, age_group, is_winter) %>%
summarise(mean_admissions = mean(number_admissions)) %>%
ggplot() +
geom_col(aes(x = ordered(age_group, levels = c("Under 5",
"5 - 14",
"15 - 44",
"45 - 64",
"65 - 74",
"75 - 84",
"85 and over")),
y = mean_admissions,
fill = is_winter), position = "dodge")
hb_agesex %>%
filter(admission_type == "Emergency",
age_group != "All ages",
hb_name == "All Scotland") %>%
group_by(hb_name, age_group, is_winter) %>%
summarise(mean_20182019_admissions = mean(average20182019)) %>%
ggplot() +
geom_col(aes(x = ordered(age_group, levels = c("Under 5",
"5 - 14",
"15 - 44",
"45 - 64",
"65 - 74",
"75 - 84",
"85 and over")),
y = mean_20182019_admissions,
fill = is_winter), position = "dodge")
#get bar graph for mean number of admissions for each month by sex
covid_sex_plotly <- hb_agesex %>%
filter(admission_type == "Emergency",
sex != "All",
hb_name == "All Scotland") %>%
group_by(hb_name, month, sex) %>%
summarise(mean_admissions = mean(number_admissions),
mean_20182019_admissions = mean(average20182019)) %>%
ggplot() +
geom_col(aes(x = month,
y = mean_admissions,
fill = sex,
text = paste0("Month: ", month,
"<br>",
"Average number of admissions: ",
round(mean_admissions),
"<br>",
"2018/2019 avg admissions: ",
round(mean_20182019_admissions))),
position = "dodge") +
labs(title = "Average admissions by month 2020 - 2022",
x = "\n Month",
y = "Mean number of admissions",
fill = "Sex")
`summarise()` has grouped output by 'hb_name', 'month'. You can override using the `.groups` argument.Warning: Ignoring unknown aesthetics: text
covid_sex_plotly %>%
ggplotly(tooltip = "text") %>%
config(displayModeBar = FALSE)
covid_age_plotly <- hb_agesex %>%
filter(admission_type == "Emergency",
age_group != "All ages",
hb_name == "All Scotland") %>%
group_by(hb_name, age_group, is_winter) %>%
summarise(mean_admissions = mean(number_admissions),
mean_20182019_admissions = mean(average20182019)) %>%
ggplot() +
geom_col(aes(x = ordered(age_group, levels = c("Under 5",
"5 - 14",
"15 - 44",
"45 - 64",
"65 - 74",
"75 - 84",
"85 and over")),
y = mean_admissions,
fill = if_else(is_winter == TRUE,
"Winter", "Not winter"),
text = paste0("Age group: ", age_group,
"<br>",
"Average number of admissions: ",
round(mean_admissions),
"<br>",
"2018/2019 avg admissions: ",
round(mean_20182019_admissions))),
position = "dodge") +
labs(title = "Average admissions by age group 2020 - 2022",
x = "\n Age group",
y = "Mean number of admissions",
fill = "Season")
`summarise()` has grouped output by 'hb_name', 'age_group'. You can override using the `.groups` argument.Warning: Ignoring unknown aesthetics: text
covid_age_plotly %>%
ggplotly(tooltip = "text") %>%
config(displayModeBar = FALSE)
hb_simd <- read_csv("raw_data/covid_raw_data/hospital_admissions_hb_simd_20220302.csv") %>% clean_names()
hb_simd %>% names(
)
hb_specialty <- read_csv("raw_data/covid_raw_data/hospital_admissions_hb_specialty_20220302.csv") %>% clean_names()
hb_specialty %>% names()
#join with hb_names to get hb names
hb_specialty <- hb_specialty %>%
left_join(hb_names, by = "hb")
#change week_ending into date format
hb_specialty <- hb_specialty %>%
mutate(week_ending = ymd(week_ending))
hb_specialty <- hb_specialty %>%
mutate(month = month(week_ending, label = TRUE),
year = year(week_ending), .after = week_ending)
#create winter and non winter groups
hb_specialty <- hb_specialty %>%
mutate(is_winter = if_else(
month %in% c("Dec", "Jan", "Feb"), TRUE, FALSE
), .after = month)
#impute NAs in hb_name with all scotland b/c these are only for the all scotland hb code
hb_specialty <- hb_specialty %>%
mutate(hb_name = if_else(
is.na(hb_name),
"All Scotland",
hb_name
))
#get graph for winter vs non-winter means by specialty for emergency admissions
hb_specialty %>%
filter(admission_type == "Emergency",
specialty != "All",
hb_name == "All Scotland") %>%
group_by(hb_name, specialty, is_winter) %>%
summarise(mean_admissions = mean(number_admissions)) %>%
ggplot() +
geom_col(aes(x = specialty,
y = mean_admissions,
fill = is_winter), position = "dodge") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7))
hb_specialty %>%
filter(admission_type == "Emergency",
specialty != "All",
hb_name == "All Scotland") %>%
group_by(hb_name, specialty, is_winter) %>%
summarise(mean_20182019_admissions = mean(average20182019)) %>%
ggplot() +
geom_col(aes(x = specialty,
y = mean_20182019_admissions,
fill = is_winter), position = "dodge") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7))
#get winter vs non-winter means by specialty for emergency admissions
hb_specialty %>%
filter(admission_type == "Emergency",
specialty != "All",
hb_name == "All Scotland") %>%
group_by(hb_name, specialty, is_winter) %>%
summarise(median_admissions = median(number_admissions)) %>%
ggplot() +
geom_col(aes(x = specialty,
y = median_admissions,
fill = is_winter), position = "dodge") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7))
hb_specialty %>%
filter(admission_type == "Emergency",
specialty != "All",
hb_name == "All Scotland") %>%
group_by(hb_name, specialty, is_winter) %>%
summarise(mean_20182019_admissions = mean(average20182019)) %>%
ggplot() +
geom_col(aes(x = specialty,
y = mean_20182019_admissions,
fill = is_winter), position = "dodge") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7))
#grouped summary table by admission type
hb_specialty %>%
filter(specialty == "All",
hb_name == "All Scotland") %>%
group_by(admission_type) %>%
summarise(mean_admissions_covid = mean(number_admissions),
mean_admissions_precovid = mean(average20182019),
diff_mean_precovid_postcovid = mean_admissions_precovid - mean_admissions_covid)
#grouped summary table by specialty and admission type for all Scotland
hb_specialty %>%
filter(specialty != "All",
hb_name == "All Scotland",
admission_type != "All") %>%
group_by(month, specialty, admission_type) %>%
summarise(mean_admissions_covid = mean(number_admissions),
mean_admissions_precovid = mean(average20182019),
diff_mean_precovid_postcovid = mean_admissions_precovid - mean_admissions_covid) %>%
ggplot() +
geom_point(aes(x = month,
y = mean_admissions_covid),
colour = "red") +
geom_line(aes(x = month,
y = mean_admissions_covid),
colour = "red", group = 1) +
geom_point(aes(x = month,
y = mean_admissions_precovid),
colour = "blue") +
geom_line(aes(x = month,
y = mean_admissions_precovid),
colour = "blue", group = 1) +
facet_grid(rows = vars(specialty),
cols = vars(admission_type), scales = "free_y")
#grouped summary table of mean admissions by hb, specialty and admission type for each month
hb_specialty %>%
filter(specialty != "All",
hb_name != "All Scotland",
admission_type != "All") %>%
group_by(hb_name, month, specialty, admission_type) %>%
summarise(mean_admissions_covid = mean(number_admissions),
mean_admissions_precovid = mean(average20182019),
#get diff in means precovid vs during covid
diff_mean_precovid_postcovid = mean_admissions_precovid - mean_admissions_covid) %>%
#see only observations where the mean admissions increased during covid years
filter(diff_mean_precovid_postcovid <= -1)
hb_specialty %>%
filter(specialty != "All",
hb_name != "All Scotland") %>%
group_by(hb_name, specialty, is_winter, admission_type) %>%
summarise(mean_admissions_covid = mean(number_admissions),
mean_admissions_precovid = mean(average20182019),
#get diff in means precovid vs during covid
diff_mean_precovid_postcovid = mean_admissions_precovid - mean_admissions_covid) %>%
#see only observations where the mean admissions increased during covid years
filter(diff_mean_precovid_postcovid <= -1)
For the average 20182019 admissions, certain specialties saw an increase in average number of emergency admissions per week during the winter period. These were: -Medical (both including and exluding Cardiology and Cancer) -Pediatrics (both including and exluding Cardiology and Cancer)
These same increases actually lessened during the Covid years 2020/2021/2022 to the point where there was only a small increase during the winter months. During the Covid years, there was a slight increase in average number of emergency admissions per week for Cardiology and for Surgery, which is notable because average emergency surgery admissions actually decreased in the winter pre-Covid
#get line graph of average number of admissions over time for each specialty
hb_specialty %>%
filter(admission_type == "Emergency",
specialty != "All",
hb_name == "All Scotland") %>%
group_by(hb_name, week_ending, specialty) %>%
summarise(mean_admissions = mean(number_admissions)) %>%
ggplot() +
geom_line(aes(x = week_ending,
y = mean_admissions,
colour = specialty)) +
scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4)+
geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4)+
geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4)+
labs(x = "Date",
y = "Average number of admissions per week",
colour = "Specialty")
hb_specialty %>%
filter(admission_type == "Emergency",
specialty != "All",
hb_name == "All Scotland") %>%
group_by(hb_name, month, specialty) %>%
summarise(mean_20182019_admissions = mean(average20182019)) %>%
ggplot() +
geom_point(aes(x = month,
y = mean_20182019_admissions,
colour = specialty)) +
geom_line(aes(x = month,
y = mean_20182019_admissions,
colour = specialty), group = hb_specialty$specialty) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
labs(x = "Date",
y = "Average number of admissions per week",
colour = "Specialty")
hscp_agesex <- read_csv("raw_data/covid_raw_data/hospital_admissions_hscp_agesex_20220302.csv") %>% clean_names()
hscp_agesex %>% names()
Again, the HSCP code is not very helpful, it would be more useful to have the HSCP names and the HB they are tied to.
#read in hscp names dataset
hscp_names <- read_csv("raw_data/covid_raw_data/hscp_names.csv") %>% clean_names()
#select the variables we need to add to the main table
hscp_names <- hscp_names %>%
select(hscp, hscp_name, hb, hb_name)
#join with hscp_names to get hscp and hb names
hscp_agesex <- hscp_agesex %>% left_join(hscp_names, by = "hscp")
I noticed that HSCP and HB datasets contained the same variables and HSCP datasets contained the HB as well, so I thought that they might be interchangable since, in theory, when you group HSCP datasets by HB, the number of admissions should aggregate to the same numbers as the HB datasets since they are for the same time periods. This isn’t the case. The HSCP dataset recorded higher numbers of admissions when aggregated by HB and compared with the HB dataset.
#summarise no of admissions by sex/age_group for each HB
hscp_agesex %>%
group_by(hb, sex, age_group, admission_type) %>%
summarise(total_admissions_by_sex = sum(number_admissions))
#summarise no of admissions by sex/age_group for each HB
hb_agesex %>%
group_by(hb, sex, age_group, admission_type) %>%
summarise(total_admissions_by_sex = sum(number_admissions))
#check number of admissions in each dataset for a random HB for the same week_ending date
hscp_agesex %>%
select(week_ending, hb, age_group, sex, admission_type, number_admissions) %>%
filter(hb == "S08000015",
week_ending == "20200105") %>%
group_by(week_ending, hb, sex, age_group, admission_type) %>%
summarise(total_admissions = sum(number_admissions))
hb_agesex %>%
select(week_ending, hb, age_group, sex, admission_type, number_admissions) %>%
filter(hb == "S08000015",
week_ending == "2020-01-05") %>%
group_by(week_ending, hb, sex, age_group, admission_type) %>%
summarise(total_admissions = sum(number_admissions))
We should ask which dataset should be considered “correct” - I would suggest selecting the HSCP datasets b/c the numbers are higher, which makes me think that some admissions weren’t recorded in the HB dataset.
Can we get the proportion for no of admissions to population in each HB or HSCP? This would allow us to carry out statistical tests to see if any HBs or HSCPs have a higher proportion of admissions compared with Scotland overall
ae_wait_times <- read_csv("raw_data/non_covid_raw_data/monthly_ae_waitingtimes_202206.csv") %>% clean_names()
ae_wait_times %>% names()
ae_wait_times %>% distinct(hbt) # note: need to join hb names
ae_wait_times %>% filter(is.na(number_meeting_target_aggregate))
#select only variables needed for summary table
ae_attendance_summary <- ae_wait_times %>%
select(month, hbt, number_of_attendances_aggregate,
discharge_destination_admission_to_same,
discharge_destination_other_specialty,
discharge_destination_residence,
discharge_destination_transfer,
discharge_destination_unknown)
#create separate month and year columns
ae_attendance_summary <- ae_attendance_summary %>%
mutate(month_year = month, .before = month)
ae_attendance_summary <- ae_attendance_summary %>%
mutate(month = month(ym(month_year), label = TRUE),
year = year(ym(month_year)), .after = month_year)
#join with hb_names
ae_attendance_summary <- ae_attendance_summary %>%
left_join(hb_names, by = c("hbt" = "hb"))
#make all scotland attendance table
all_scotland_attendance <- ae_attendance_summary %>%
group_by(year, month) %>%
filter(year >= 2017) %>%
summarise(num_attendances = sum(number_of_attendances_aggregate),
admission_to_same = sum(discharge_destination_admission_to_same, na.rm = TRUE),
other_specialty = sum(discharge_destination_other_specialty, na.rm = TRUE),
residence = sum(discharge_destination_residence, na.rm = TRUE),
transfer = sum(discharge_destination_transfer, na.rm = TRUE),
unknown = sum(discharge_destination_unknown, na.rm = TRUE))
#get proportions for destinations
all_scotland_attendance <- all_scotland_attendance %>%
rowwise() %>%
mutate(
total_avg_discharge = sum(c(admission_to_same, other_specialty,
residence, transfer, unknown)),
prop_admission = admission_to_same/total_avg_discharge,
prop_other_specialty = other_specialty/total_avg_discharge,
prop_residence = residence/total_avg_discharge,
prop_transfer = transfer/total_avg_discharge,
prop_unknown = unknown/total_avg_discharge
)
ae_attendance_summary <- ae_attendance_summary %>%
group_by(hb_name, year, month) %>%
summarise(num_attendances = sum(number_of_attendances_aggregate),
admission_to_same = sum(discharge_destination_admission_to_same, na.rm = TRUE),
other_specialty = sum(discharge_destination_other_specialty, na.rm = TRUE),
residence = sum(discharge_destination_residence, na.rm = TRUE),
transfer = sum(discharge_destination_transfer, na.rm = TRUE),
unknown = sum(discharge_destination_unknown, na.rm = TRUE))
ae_attendance_summary <- ae_attendance_summary %>%
rowwise() %>%
mutate(
total_avg_discharge = sum(c(admission_to_same, other_specialty,
residence, transfer, unknown)),
prop_admission = admission_to_same/total_avg_discharge,
prop_other_specialty = other_specialty/total_avg_discharge,
prop_residence = residence/total_avg_discharge,
prop_transfer = transfer/total_avg_discharge,
prop_unknown = unknown/total_avg_discharge
)
#add columns to all scotland
all_scotland_attendance <- all_scotland_attendance %>%
mutate(hb_name = "All Scotland")
#select relevant columns
ae_attendance_summary <- ae_attendance_summary %>%
filter(year >=2017) %>%
select(year, month, hb_name, num_attendances, prop_admission,
prop_other_specialty, prop_residence, prop_transfer, prop_unknown)
all_scotland_attendance <- all_scotland_attendance %>%
select(year, month, hb_name, num_attendances, prop_admission,
prop_other_specialty, prop_residence, prop_transfer, prop_unknown)
#bind rows
ae_attendance_summary <- ae_attendance_summary %>%
bind_rows(all_scotland_attendance)
#separate dataset into preCovid and Covid year ranges
covid_ae_attendance <- ae_attendance_summary %>%
filter(year >= 2020)
precovid_ae_attendance <- ae_attendance_summary %>%
filter(year < 2020)
#get 2017-2019 avgs to add as comparator to covid dataset
precovid_ae_attendance <- precovid_ae_attendance %>%
group_by(hb_name, month) %>%
summarise(avg_attendances_20171819 = mean(num_attendances),
avg_prop_admission_20171829 = mean(prop_admission),
avg_prop_other_specialty_20171819 = mean(prop_other_specialty),
avg_prop_residence_20171819 = mean(prop_residence),
avg_prop_transfer_20171819 = mean(prop_transfer),
avg_prop_unknown_20171819 = mean(prop_unknown))
#create key to join with covid_ae_attendance
precovid_ae_attendance <- precovid_ae_attendance %>%
mutate(hb_key = paste0(hb_name, "_", month), .before = hb_name)
#select only key and avg variables
precovid_ae_attendance <- precovid_ae_attendance %>%
subset(select = -c(hb_name, month))
covid_ae_attendance <- covid_ae_attendance %>%
mutate(hb_key = paste0(hb_name, "_", month), .before = hb_name)
covid_ae_attendance <- covid_ae_attendance %>%
left_join(precovid_ae_attendance, by = "hb_key")
covid_ae_attendance <- covid_ae_attendance %>%
mutate(date = (paste0(year, "-", month)), .before = year) %>%
mutate(date = ym(date), .before = year)
#put data in long format
covid_ae_attendance <- covid_ae_attendance %>%
pivot_longer(
cols = starts_with("prop"),
names_to = "destination",
values_to = "destination_prop"
)
covid_ae_attendance <- covid_ae_attendance %>%
mutate(
avg_prop_20171819 = case_when(
destination == "prop_admission" ~ avg_prop_admission_20171829,
destination == "prop_other_specialty" ~ avg_prop_other_specialty_20171819,
destination == "prop_residence" ~ avg_prop_residence_20171819,
destination == "prop_transfer" ~ avg_prop_transfer_20171819,
destination == "prop_unknown" ~ avg_prop_unknown_20171819
)
)
covid_ae_attendance <- covid_ae_attendance %>%
select(date, year, month, hb_key, hb_name, num_attendances,
avg_attendances_20171819, destination,
destination_prop, avg_prop_20171819)
covid_ae_attendance_plotly <- covid_ae_attendance %>%
filter(hb_name == "All Scotland") %>%
ggplot() +
geom_point(aes(x = date,
y = num_attendances,
text = paste0("Date: ", year, "-", month,
"<br>",
"Number of admissions: ", num_attendances,
"<br>",
"2017-2019 avg admissions: ",
round(avg_attendances_20171819)))) +
geom_line(aes(x = date,
y = num_attendances)) +
scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4, colour = "grey50")+
geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4, colour = "grey50")+
geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4, colour = "grey50")+
labs(title = "Number of attendances at A&E 2020 - 2022 \n",
x = "Date",
y = "Number of Attendances")
Warning: Ignoring unknown aesthetics: text
covid_ae_attendance_plotly %>%
ggplotly(tooltip = "text") %>%
config(displayModeBar = FALSE) %>%
layout(hoverlabel = list(bgcolor = "white"))
covid_ae_destinations_plotly <- covid_ae_attendance %>%
filter(hb_name == "All Scotland") %>%
ggplot() +
geom_point(aes(x = date,
y = destination_prop,
colour = destination,
text = paste0("Date: ", year, "-", month,
"<br>",
"Percentage: ",
round(destination_prop*100, digits = 2),
"%",
"<br>",
"2017-2019 percentage: ",
round(avg_prop_20171819*100, digits = 2),
"%"))) +
geom_line(aes(x = date,
y = destination_prop,
group = destination)) +
scale_x_date(date_breaks = "3 months", date_labels = "%b %Y") +
scale_y_sqrt() +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4, colour = "grey50")+
geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4, colour = "grey50")+
geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4, colour = "grey50")+
labs(title = "Destination of attendances at A&E 2020 - 2022 \n",
x = "Date",
y = "Proportion of attendances",
colour = "Destination")
Warning: Ignoring unknown aesthetics: text
covid_ae_destinations_plotly %>%
ggplotly(tooltip = "text") %>%
config(displayModeBar = FALSE)
NA
NA
waiting_times <- read_csv("raw_data/non_covid_raw_data/monthly_ae_waitingtimes_202206.csv") %>% clean_names()
Rows: 15837 Columns: 25-- Column specification -------------------------------------------------------------------------------------------
Delimiter: ","
chr (13): Country, HBT, TreatmentLocation, DepartmentType, NumberOfAttendancesEpisodeQF, NumberMeetingTargetEpi...
dbl (12): Month, NumberOfAttendancesAggregate, NumberOfAttendancesEpisode, NumberMeetingTargetAggregate, Number...
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
#get date and quarter values
waiting_times <- waiting_times %>%
mutate(date = ym(month),
quarter = quarter(date))
#get proportions for all destinations
waiting_times <- waiting_times %>%
mutate(
prop_admission_to_same = (discharge_destination_admission_to_same/number_of_attendances_aggregate)
) %>%
mutate(prop_other_speciality = (discharge_destination_other_specialty/number_of_attendances_aggregate)) %>%
mutate(prop_residence = (discharge_destination_residence/number_of_attendances_aggregate)) %>%
mutate(prop_transfer = (discharge_destination_transfer/number_of_attendances_aggregate)) %>%
mutate(prop_unknown = (discharge_destination_unknown/number_of_attendances_aggregate))
#change to long format
waiting_times <- waiting_times %>%
pivot_longer(cols = prop_admission_to_same:prop_unknown, names_to = "discharge_destination", values_to = "discharge_proportion")
#clean up values for destinations
waiting_times <- waiting_times %>%
mutate(discharge_destination = case_when(
str_detect(discharge_destination, "prop_admission_to_same") ~
"Admission to Same Facility",
str_detect(discharge_destination, "prop_other_speciality") ~
"Discharged to private provider/died",
str_detect(discharge_destination, "prop_residence") ~
"Discharged to private residence",
str_detect(discharge_destination, "prop_transfer") ~
"Transferred to another NHS provider",
str_detect(discharge_destination, "prop_unknown") ~
"Unknown or other discharge destination"
))
#read in clean data
waiting_times <- read_csv("clean_data/wait_times.csv")
Rows: 79185 Columns: 29-- Column specification ------------------------------------------------------------------------------------------
Delimiter: ","
chr (14): country, hbt, treatment_location, department_type, number_of_attendances_episode_qf, number_meeting...
dbl (14): month, number_of_attendances_aggregate, number_of_attendances_episode, number_meeting_target_aggreg...
date (1): date
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
winter_plotly <- waiting_times %>%
filter(discharge_destination == "Admission to Same Facility",
!is.na(discharge_proportion)) %>%
group_by(date) %>%
summarise(mean_admission_to_same = mean(discharge_proportion)) %>%
ggplot() +
geom_point(aes(x = date,
y = mean_admission_to_same,
text = paste0("Date: ", date,
"<br>",
"Percentage: ",
round(mean_admission_to_same*100, digits = 2),
"%"))) +
geom_line(aes(x = date,
y = mean_admission_to_same)) +
scale_x_date(date_breaks = "6 months", date_labels = "%b %Y") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, size =7)) +
geom_vline(xintercept = as.numeric(as.Date("2008-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2009-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2010-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2011-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2012-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2013-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2014-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2015-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2016-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2017-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2018-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2019-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2020-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2021-01-01")), linetype=4, colour = "grey50", alpha = 0.7)+
geom_vline(xintercept = as.numeric(as.Date("2022-01-01")), linetype=4, colour = "grey50", alpha = 0.7) +
labs(title = "Proportion of attendances to selected destination \n",
x = "\n Date",
y = "Proportion of attendances")
Warning: Ignoring unknown aesthetics: text
winter_plotly %>%
ggplotly(tooltip = "text") %>%
config(displayModeBar = FALSE) %>%
layout(hoverlabel = list(bgcolor = "white"))
NA